Option Strict Off
Option Explicit On
Module MiscModules
	
	
	
	
	
	
	
	
	Private Declare Function timeGetTime Lib "winmm.dll" () As Integer
	
	Dim TimeStartDelay, TimeEndDelay As Double
	
	Public OldWindowProc As Integer
	'UPGRADE_WARNING: Structure WINDOWPOS may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
	Declare Function CallWindowProc Lib "user32"  Alias "CallWindowProcA"(ByVal lpPrevWndFunc As Integer, ByVal hwnd As Integer, ByVal msg As Integer, ByVal wParam As Integer, ByRef lParam As WINDOWPOS) As Integer
	Declare Function SetWindowLong Lib "user32"  Alias "SetWindowLongA"(ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
	Public Const GWL_WNDPROC As Short = (-4)
	
	Structure WINDOWPOS
		Dim hwnd As Integer
		Dim hWndInsertAfter As Integer
		Dim X As Integer
		Dim Y As Integer
		Dim cx As Integer
		Dim cy As Integer
		Dim flags As Integer
	End Structure
	
	Public Const WM_WINDOWPOSCHANGING As Integer = &H46
	Public AspFix As Boolean 'A flag which when true enables the AspectRatio module to function
	
	
	'Declare API that plays sound
	Private Declare Function sndPlaySound Lib "winmm.dll"  Alias "sndPlaySoundA"(ByVal lpszSoundName As String, ByVal uFlags As Integer) As Integer
	'Sound Constants to Play a Wav File
	Const SND_SYNC As Integer = &H0
	Const SND_ASYNC As Integer = &H1
	Const SND_NODEFAULT As Integer = &H2
	Const SND_MEMORY As Integer = &H4
	Const SND_LOOP As Integer = &H8
	Const SND_NOSTOP As Integer = &H10
	
	Dim Shutter As String
	
	
	'Loads a sound from file into memory
	Public Sub LoadSound()
		Dim SoundBuffer As String
		
		SoundBuffer = Space(FileLen(My.Application.Info.DirectoryPath & "\Sounds\" & CaptureSound & ".wav")) 'Make room for sound file
		FileOpen(2, My.Application.Info.DirectoryPath & "\Sounds\" & CaptureSound & ".wav", OpenMode.Binary)
		'UPGRADE_WARNING: Get was upgraded to FileGet and has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
		FileGet(2, SoundBuffer) 'load in blaster sound
		FileClose() 'close all open files
		'remove wasted spaces at start of sound
		Shutter = Trim(SoundBuffer) 'trim leading spaces and store sound in string variable
		
	End Sub
	
	Public Sub CameraShutter()
		Call sndPlaySound(Shutter, SND_ASYNC Or SND_MEMORY) 'Play the sound of the camera shutter
	End Sub
	
	Public Function NewWindowProc(ByVal hwnd As Integer, ByVal msg As Integer, ByVal wParam As Integer, ByRef lParam As WINDOWPOS) As Integer
		'Enables windows to be scaled, but fixes their aspect ratio whilst scaling used for the capture and playback windows
		Static done_before As Boolean
		'Dim aspect As Single
		Dim new_aspect As Single
		If AspFix = False Then GoTo NoAspectFix 'check if aspect ratio fixing is required
		' Keep the aspect ratio.
		If msg = WM_WINDOWPOSCHANGING Then
			If lParam.cy > 0 Then
				'The aspect ratio is not fixed as the title bar remains at a constant height whilst the working area of the form scales
				'in a ratio defined by the AspRatio value. ie the aspect ratio of the captured image
				lParam.cy = (lParam.cx / AspRatio) + TitleHeight
			End If
		End If
NoAspectFix: 
		' Continue normal processing. VERY IMPORTANT!
		NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
	End Function
	Public Function NewWindowProc1(ByVal hwnd As Integer, ByVal msg As Integer, ByVal wParam As Integer, ByRef lParam As WINDOWPOS) As Integer
		'Enables windows to be scaled, but fixes their aspect ratio whilst scaling used for the rotoscope window
		Static done_before As Boolean
		'Dim aspect As Single
		Dim new_aspect As Single
		If AspFix = False Then GoTo NoAspectFix 'check if aspect ratio fixing is required
		' Keep the aspect ratio.
		If msg = WM_WINDOWPOSCHANGING Then
			If lParam.cy > 0 Then
				'The aspect ratio is not fixed as the title bar remains at a constant height whilst the working area of the form scales
				'in a ratio defined by the AspRatio value. ie the aspect ratio of the captured image
				lParam.cy = (lParam.cx / AspRatio) + TitleHeight + 33 'aspect ratio of 4:3 + an allowance for the buttons and title above image
			End If
		End If
NoAspectFix: 
		' Continue normal processing. VERY IMPORTANT!
		NewWindowProc1 = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
	End Function
	Public Sub PauseDelayMilliSec(ByRef SecRequired As Double)
		
		TimeEndDelay = timeGetTime() + SecRequired
KeepCounting: 
		TimeStartDelay = timeGetTime() 'stores the current time
		If TimeStartDelay < TimeEndDelay Then GoTo KeepCounting 'loop until end time is reached
	End Sub
	Public Function MakeRegion(ByRef ppicSkin As System.Windows.Forms.PictureBox) As Integer 'Input a picturebox and it returns a region that is the non transparent area of the picturebox
		'This function recieves a picturebox object type. It then examines each pixel to see if it is not white and produces a "region" which only covers the non white areas
		'The region is then returned. The main program then sets using the API SetWindowRgn call the picturebox so nothing outside this area is active or visible. This has the
		'effect of producing a non rectangular picturebox.
		
		Dim lngX As Integer
		Dim lngY As Integer
		Dim lngStartLineX As Integer
		Dim lngFullRegion As Integer
		Dim lngLineRegion As Integer
		Dim lngTransparentColor As Integer
		Dim blnInFirstRegion As Boolean
		Dim blnInLine As Boolean
		Dim lngHDC As Integer
		Dim lngWidth As Integer
		Dim lngHeight As Integer
		Dim RGN_OR As Integer
		RGN_OR = 2
		'UPGRADE_ISSUE: PictureBox property ppicSkin.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'


        Dim lngGraph As Graphics = ppicSkin.CreateGraphics
        lngHDC = lngGraph.GetHdc

        'lngHDC = ppicSkin.hdc 'Get the memory pointer to the picturebox
		lngWidth = VB6.PixelsToTwipsX(ppicSkin.ClientRectangle.Width) 'Get the width of the picturebox
		lngHeight = VB6.PixelsToTwipsY(ppicSkin.ClientRectangle.Height) 'Get the height of the picturebox
		blnInFirstRegion = True
		blnInLine = False
		lngX = 0
		lngY = 0
		lngStartLineX = 0
		lngTransparentColor = RGB(255, 255, 255) 'Set the transparent colour to white
		'Loop through all the picturebox pixels , find if they are not transparent and add this to a region
		'At the end of the looping, a region called makeregion is returned that only represents the active (non transparent area of the picturebox)
		For lngY = 0 To lngHeight - 1
			For lngX = 0 To lngWidth - 1
				If (GetPixel(lngHDC, lngX, lngY) = lngTransparentColor) Or (lngX = lngWidth) Then 'If the pixel is black or the end of line has been reached then
					If blnInLine Then
						blnInLine = False
						lngLineRegion = CreateRectRgn(lngStartLineX, lngY, lngX, lngY + 1)
						If blnInFirstRegion Then
							lngFullRegion = lngLineRegion
							blnInFirstRegion = False
						Else
							CombineRgn(lngFullRegion, lngFullRegion, lngLineRegion, RGN_OR)
							DeleteObject(lngLineRegion)
						End If
					End If
				Else
					If Not blnInLine Then
						blnInLine = True
						lngStartLineX = lngX
					End If
				End If
			Next lngX
        Next lngY

        lngGraph.ReleaseHdc(lngHDC)
        lngGraph.Dispose()


		MakeRegion = lngFullRegion
	End Function
	'Function for loading graphics into memory (Device Contexts "DC")
	Public Function LoadGraphicDC(ByRef sFilename As String) As Integer
		
		On Error Resume Next 'Quick error handling
		Dim LoadGraphicDCTEMP As Integer 'Temp variable to hold DC address
		LoadGraphicDCTEMP = CreateCompatibleDC(GetDC(0)) 'Create the DC address compatible with the DC of the screen
		SelectObject(LoadGraphicDCTEMP, CInt(CObj(System.Drawing.Image.FromFile(sFilename)))) 'Load the graphic file into the DC...
		LoadGraphicDC = LoadGraphicDCTEMP 'Return the handle to the DC
		
	End Function
	
	'Funtion to remove Bitmap and DC from memory
	Public Function CleanDC(ByRef Handle1 As Object) As Object
		
		'UPGRADE_WARNING: Couldn't resolve default property of object Handle1. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		DeleteObject(Handle1)
		'UPGRADE_WARNING: Couldn't resolve default property of object Handle1. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		DeleteDC(Handle1) 'delete the device context
		
	End Function
	
	
	Public Sub DisableCloseWindowButton(ByRef frm As System.Windows.Forms.Form)
		'This subroutine disables the close button at the top right of the form.
		Dim hSysMenu As Integer
		
		'Get the handle to this windows
		'system menu
		hSysMenu = GetSystemMenu(frm.Handle.ToInt32, 0)
		
		'Remove the Close menu item
		'This will also disable the close button
		RemoveMenu(hSysMenu, 6, MF_BYPOSITION)
		
		'Lastly, we remove the seperator bar
		RemoveMenu(hSysMenu, 5, MF_BYPOSITION)
		
	End Sub
	Public Function DragWindow(ByRef HandleToButtonWindow As Integer, ByRef HotSpotDC As Integer) As Boolean 'Returns true if mouse is over the buttons window, but not over a button
		DragWindow = False
		LMouseButStatus = 0 'Reset the flag , ie button not pressed
		Call GetCursorPos(MousePoint) 'Get the screen position of the cursor
		Call ScreenToClient(HandleToButtonWindow, MousePoint) 'Modify values so they are relative to top left of Buttons picture window
		PixCol = GetPixel(HotSpotDC, MousePoint.X, MousePoint.Y) 'Get the relative colour at the mouse point of the hotspot image in memory
		Red = PixCol And &HFF : Green = CShort(PixCol And &HFF00) / 256 : Blue = CShort(PixCol And &HFF0000) / 65535 'Get the value of each color byte (rgb)
		If Red = 200 And Green = 250 And Blue = 200 Then DragWindow = True 'The mouse is over the body of the button window and not over a button.
    End Function

    Public Function VarPtr(ByVal o As Object) As Integer
        Dim GC As System.Runtime.InteropServices.GCHandle = System.Runtime.InteropServices.GCHandle.Alloc(o, System.Runtime.InteropServices.GCHandleType.Pinned)
        Dim ret As Integer = GC.AddrOfPinnedObject.ToInt32
        GC.Free()    
        Return ret

    End Function

End Module